home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples2.1.Lha / Examples / StrHooks / StrHooks.bas < prev   
Encoding:
BASIC Source File  |  1994-04-14  |  6.8 KB  |  211 lines
  1. ''
  2. '' $Id: StrHooks.bas,v 1.2 1994/03/16 15:00:38 alex Rel $
  3. ''
  4. '' String gadget hook demo
  5. ''
  6. '' Derived from RKM example (c) Copyright 1992 Commodore-Amiga, Inc.
  7. ''
  8.  
  9. DEFINT A-Z
  10.  
  11. REM $NOWINDOW    ' don't need the automatic window in this example
  12.  
  13. 'REM $INCLUDE Exec.bh
  14. 'REM $INCLUDE Graphics.bc
  15. 'REM $INCLUDE Intuition.bh
  16. 'REM $INCLUDE Locale.bh
  17. 'REM $INCLUDE Utility.bc
  18.  
  19. ' The callback operates in Intuition's context - lets turn everything off
  20. REM $NOAUTODIM
  21. REM $NOARRAY
  22. REM $NOBREAK
  23. REM $NOOVERFLOW
  24. REM $NOEVENT
  25. REM $NOSTACK
  26.  
  27. LIBRARY OPEN "exec.library", LIBRARY_MINIMUM&
  28. LIBRARY OPEN "intuition.library", 37
  29. LIBRARY OPEN "locale.library", 38
  30.  
  31. CONST SG_STRLEN = 44
  32. CONST MYSTRGADWIDTH = 200
  33.  
  34. DIM SHARED locale&    ' default global locale
  35. DIM SHARED tl&(40)
  36. DIM SHARED junk&
  37.  
  38. ' This is an example string editing hook, which shows the basics of
  39. ' creating a string editing function.  This hook restricts entry to
  40. ' hexadecimal digits (0-9, A-F, a-f) and converts them to upper case.
  41. ' To demonstrate processing of mouse-clicks, this hook also detects
  42. ' clicking on a character, and converts it to a zero.
  43. '
  44. ' NOTE: String editing hooks are called on Intuition's task context,
  45. ' so the hook may not use DOS and may not cause xWait&() to be called.
  46.  
  47. FUNCTION str_hookRoutine&(BYVAL hook&, BYVAL sgw&, BYVAL msg&)
  48.     ' Hook must return non-zero if command is supported.
  49.     ' This will be changed to zero if the command is unsupported.
  50.     str_hookRoutine& = NOT 0&
  51.  
  52.     IF PEEKL(msg&) = SGH_KEY& THEN
  53.         ' key hit -- could be any key (Shift, repeat, character, etc.) */
  54.  
  55.         ' allow only upper case characters to be entered.
  56.         ' act only on modes that add or update characters in the buffer.
  57.         IF PEEKW(sgw& + EditOp) = EO_REPLACECHAR& OR _
  58.           PEEKW(sgw& + EditOp) = EO_INSERTCHAR& THEN
  59.  
  60.             ' Code contains the ASCII representation of the character
  61.             ' entered, if it maps to a single byte.  We could also look
  62.             ' into the work buffer to find the new character.
  63.             '
  64.             ' If the character is not a legal hex digit, don't use
  65.             ' the work buffer and beep the screen.
  66.  
  67.             IF IsXDigit(locale&, PEEKW(sgw& + SGWorkCode)) = FALSE& THEN
  68.                 POKEL sgw& + Actions, (PEEKL(sgw& + Actions) OR SGA_BEEP&) AND NOT SGA_USE&
  69.             ELSE
  70.                 ' And make it upper-case, for nicety
  71.                 
  72.                 POKEB PEEKL(sgw& + SGWorkWorkBuffer) + PEEKW(sgw& + SGWorkBufferPos) - 1, _
  73.                   ConvToUpper(locale&, PEEKW(sgw& + SGWorkCode))
  74.             END IF
  75.         END IF
  76.     ELSEIF PEEKL(msg&) = SGH_CLICK& THEN
  77.         ' mouse click
  78.         ' zero the digit clicked on
  79.  
  80.         IF PEEKW(sgw& + SGWorkBufferPos) < PEEKW(sgw& + SGWorkNumChars) THEN
  81.             POKEB PEEKL(sgw& + SGWorkWorkBuffer) + PEEKW(sgw& + SGWorkBufferPos), ASC("0")
  82.         END IF
  83.     ELSE
  84.         ' UNKNOWN COMMAND
  85.         ' hook should return zero if the command is not supported.
  86.  
  87.         str_hookRoutine& = 0
  88.     END IF
  89. END FUNCTION
  90.  
  91. DIM SHARED strBorderData(9), strBorder(Border_sizeof \ 2)
  92. DIM SHARED sgg_Gadget(Gadget_sizeof \ 2), sgg_StrInfo(StringInfo_sizeof \ 2)
  93. DIM SHARED sgg_Extend(StringExtend_sizeof \ 2), sgg_Hook(Hook_sizeof \ 2)
  94. DIM SHARED sgg_Buff(SG_STRLEN \ 2), sgg_WBuff(SG_STRLEN \ 2), sgg_UBuff(SG_STRLEN \ 2)
  95.  
  96. SUB main
  97.     STATIC scr&, drawinfo&, win&, closed, imsg&, imsgClass&, w&
  98.  
  99.     locale& = OpenLocale&(NULL&)
  100.     IF locale& <> NULL& THEN
  101.         scr& = LockPubScreen&(NULL&)
  102.         IF scr& <> NULL& THEN
  103.             drawinfo& = GetScreenDrawInfo&(scr&)
  104.             IF drawinfo& <> NULL& THEN
  105.             ' initialiase everything: Border, Hook, StringExtend, StringInfo and
  106.             ' Gadget
  107.  
  108.                 strBorderData(0) = 0 : strBorderData(1) = 0
  109.                 strBorderData(2) = MYSTRGADWIDTH + 3 : strBorderData(3) = 0
  110.                 strBorderData(4) = MYSTRGADWIDTH + 3 : strBorderData(5) = PEEKW(scr& + RastPort + TxHeight) + 3
  111.                 strBorderData(6) = 0 : strBorderData(7) = strBorderData(5)
  112.                 strBorderData(8) = 0 : strBorderData(9) = 0
  113.  
  114.                 w& = VARPTR(strBorder(0))
  115.                 POKEW w& + BorderLeftEdge, -2
  116.                 POKEW w& + BorderTopEdge, -2
  117.                 POKEB w& + BorderFrontPen, 1
  118.                 POKEB w& + BorderBackPen, 0
  119.                 POKEB w& + BorderDrawMode, JAM1&
  120.                 POKEB w& + BorderCount, 5
  121.                 POKEL w& + XY, VARPTR(strBorderData(0))
  122.                 POKEL w& + NextBorder, NULL&
  123.  
  124.                 InitHook VARPTR(sgg_Hook(0)), VARPTRS(str_hookRoutine&)
  125.  
  126.                 w& = VARPTR(sgg_Extend(0))
  127.                 POKEB w& + Pens + 0, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLTEXTPEN& * 2)
  128.                 POKEB w& + Pens + 1, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLPEN& * 2)
  129.                 POKEB w& + ActivePens + 0, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLTEXTPEN& * 2)
  130.                 POKEB w& + ActivePens + 1, PEEKW(PEEKL(drawinfo& + dri_Pens) + FILLPEN& * 2)
  131.                 POKEL w& + EditHook, VARPTR(sgg_Hook(0))
  132.                 POKEL w& + StringExtendWorkBuffer, VARPTR(sgg_WBuff(0))
  133.  
  134.                 w& = VARPTR(sgg_StrInfo(0))
  135.                 POKEL w& + StringInfoBuffer, VARPTR(sgg_Buff(0))
  136.                 POKEL w& + UndoBuffer, VARPTR(sgg_UBuff(0))
  137.                 POKEW w& + MaxChars, SG_STRLEN
  138.                 POKEL w& + StringInfoExtension, VARPTR(sgg_Extend(0))
  139.  
  140.                 w& = VARPTR(sgg_Gadget(0))
  141.                 POKEW w& + GadgetLeftEdge, 20
  142.                 POKEW w& + GadgetTopEdge, 30
  143.                 POKEW w& + GadgetWidth, MYSTRGADWIDTH
  144.                 POKEW w& + GadgetHeight, PEEKW(scr& + RastPort + TxHeight)
  145.                 POKEW w& + GadgetFlags, GFLG_GADGHCOMP& OR GFLG_STRINGEXTEND&
  146.                 POKEW w& + GadgetActivation, GACT_RELVERIFY&
  147.                 POKEW w& + GadgetGadgetType, GTYP_STRGADGET&
  148.                 POKEL w& + GadgetSpecialInfo, VARPTR(sgg_StrInfo(0))
  149.                 POKEL w& + GadgetGadgetRender, VARPTR(strBorder(0))
  150.  
  151.                 TAGLIST VARPTR(tl&(0)), _
  152.                   WA_PubScreen&, scr&, _
  153.                   WA_Left&, 21, _
  154.                   WA_Top&, 20, _
  155.                   WA_Width&, 500, _
  156.                   WA_Height&, 150, _
  157.                   WA_MinWidth&, 50, _
  158.                   WA_MaxWidth&, NOT 0&, _
  159.                   WA_MinHeight&, 30, _
  160.                   WA_MaxHeight&, NOT 0&, _
  161.                   WA_SimpleRefresh&, TRUE&, _
  162.                   WA_NoCareRefresh&, TRUE&, _
  163.                   WA_RMBTrap&, TRUE&, _
  164.                   WA_IDCMP&, IDCMP_GADGETUP& OR IDCMP_CLOSEWINDOW&, _
  165.                   WA_Activate&, TRUE&, _
  166.                   WA_CloseGadget&, TRUE&, _
  167.                   WA_DragBar&, TRUE&, _
  168.                   WA_DepthGadget&, TRUE&, _
  169.                   WA_Title&, "String Hook Accepts HEX Digits Only", _
  170.                   WA_Gadgets&, VARPTR(sgg_Gadget(0)), _
  171.                   TAG_END&
  172.  
  173.                 win& = OpenWindowTagList&(NULL&, VARPTR(tl&(0)))
  174.                 IF win& <> NULL& THEN
  175.                     closed = FALSE&
  176.                     WHILE closed = FALSE&
  177.                         junk& = WaitPort&(PEEKL(win& + UserPort))
  178.                         DO
  179.                             imsg& = GetMsg&(PEEKL(win& + UserPort))
  180.                             IF imsg& <> NULL& THEN
  181.                             ' Stash message contents and reply, important when
  182.                             ' message triggers some lengthy processing
  183.  
  184.                                 imsgClass& = PEEKL(imsg& + Class)
  185.                                 ReplyMsg imsg&
  186.                                 SELECT CASE imsgClass&
  187.                                     CASE IDCMP_GADGETUP&
  188.                                     ' if a code is set in the hook after an SGH_KEY
  189.                                     ' command, where SGA_END is set on return from
  190.                                     ' the hook, the code will be returned in the
  191.                                     ' Code field of the IDCMP_GADGETUP message.
  192.  
  193.                                     CASE IDCMP_CLOSEWINDOW&
  194.                                         closed = TRUE&
  195.                                 END SELECT
  196.                             END IF
  197.                         LOOP WHILE imsg& <> NULL&
  198.                     WEND
  199.                     CloseWindow win&
  200.                 END IF
  201.                 FreeScreenDrawInfo scr&, drawinfo&
  202.             END IF
  203.             UnlockPubScreen NULL&, scr&
  204.         END IF
  205.         CloseLocale locale&
  206.     END IF
  207. END SUB
  208.  
  209. main
  210. END
  211.